home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Applications / Alpha.5.96 folder / Tcl / UserCode / html.tcl < prev    next >
Encoding:
Text File  |  1994-08-17  |  28.9 KB  |  1,319 lines  |  [TEXT/ALFA]
  1. #================================================================================
  2. # Copyright 1994 by Scott W. Brim.  You may use this software freely, and
  3. # distribute it freely as long as the receiver is not obligated in any 
  4. # way by receiving it.  If you want to distribute it in any other way, contact 
  5. # me at swb1@cornell.edu and we'll see if we can work something out.  Special
  6. # allowances are not unusual.
  7. #================================================================================
  8. #================================================================================
  9. #
  10. # html.tcl:  macros and bindings for HTML documents
  11. #
  12. # Version 0.15
  13. #
  14. # You must have Alpha 5.85 or better to use this distribution, and Alpha 
  15. # 5.92 or better to use its advanced features.  If you don't, get the 
  16. # most recent version from cs.rice.edu under public/Alpha.  For 
  17. # information on installation and customization see HTML Help.  Ideas 
  18. # were originally taken from Marc Andreesen's html.el and Tom Scavo's 
  19. # latex.tcl
  20. #
  21. # If you make improvements to this environment, please share them!
  22. #
  23. #                                     Scott Brim <swb1@cornell.edu>
  24. #
  25. #================================================================================
  26. # 
  27. # Change Log:
  28. #
  29. # Version 0.15, 17 August 1994
  30. #
  31. #    HTML mode is now integrated into the main Alpha distribution.
  32. #    Better documentation all around.
  33. #    Use newModeVar and shadowing; remove requirement that certain flags 
  34. #        be set before or after html.tcl is loaded.
  35. #
  36. # Previous change history available if you're really interested.
  37. #
  38. #================================================================================
  39. #
  40. # To Be Done:
  41. #    Fuller HTML 2.0 implementation.  When it's complete we'll have V1.0.
  42. #    Add better color support with wordBreak and wordBreakPreface?
  43. #    An option, htmlCompactPreferred, for people who prefer compact discursive 
  44. #        lists.
  45. #    Optionally close P, LI, DD, DL.  Put this under the control of an
  46. #        option htmlPreferFull, which will include htmlUseHeadAndBody too.
  47. #    Do something about indentation when filling?
  48. #    Better searching for headers for HTMLMarkFile, e.g. to find headers even
  49. #        when there are IMGs embedded in them.
  50. #    Optional: various length dashes (with Apple-like keybindings); 
  51. #        "id" (not name) in all tags, generated automatically; doctype;
  52. #        strikethrough style, and so on.
  53. #    HTML's menu will have an "HTML 3" in it, which will totally switch the 
  54. #        menu.  In the HTML 3 menu the same position will revert back. 
  55. #        Whether to come up in HTML 2 or HTML 3 mode will depend on a 
  56. #        user-settable variable.
  57. #    When adding title, if one already exists, replace it.
  58. #    A proc to leap from anchor to href and vice versa across multiple 
  59. #        documents.
  60. #    htmlFillParagraph
  61. #    For new disc entries: want compact vs. ordinary (check context)
  62. #    "Balance"-type cmd on cmd-B, to mark text between matching tags.
  63. #    Proc in menu to take selected text & convert chars to char entities as
  64. #        needed.
  65. #    Maybe a submenu under HREF with common URL templates?
  66. #    Proc to force quotation marks in all hrefs.
  67. #    Insert template text in one lump, so that one Undo removes whole thing.
  68. #    Proc for automatic generation of table of contents?
  69. #    Anything marked with "xxx"
  70. #
  71. #================================================================================
  72.  
  73. proc loadHTML {} {
  74.     global HOME modes
  75.     addUserLine "\r\# The following lines install the HyperText Markup Language Mode"
  76.     addUserLine "source \"$HOME:Tcl:UserCode:html.tcl\""
  77.     addUserLine "catch {htmlDummy}"
  78.     addUserLine "enableMenuItem -m install HTML 0\r"
  79.  
  80.     enableMenuItem -m install HTML 0
  81.     set modes [lsort $modes]
  82. }
  83.  
  84. #This icon is present in Alpha 5.86 and beyond.  Check version.
  85. proc htmlAlphaVersion {} {
  86.     regexp {[0-9.]+} [version] vers
  87.     return $vers
  88. }
  89. if [expr [htmlAlphaVersion] < "5.86"] {
  90.     set htmlMenu    "Html"
  91. } else {
  92.     set htmlMenu    "•942"
  93. }
  94.  
  95. set htmlCommentPreString "<!-- "
  96. set htmlCommentSufString " -->"
  97.  
  98. #
  99. # Add mode to mode list.  Requires 5.85 and after.
  100. #
  101. lappend modes HTML
  102. #addMenuItem -m $helpMenu "HTML Help"
  103. set modeMenus(HTML)             htmlMenu
  104. lappend allModeMenus            htmlMenu
  105. lappend modeSuffixes            {*.html} { set winMode HTML }
  106. lappend modeSuffixes            {*.HTML} { set winMode HTML }
  107. set dummyProc(HTML)    htmlDummy
  108.  
  109. newModeVar HTML wordBreakPreface    {[^a-zA-Z0-9_/]}    0
  110. newModeVar HTML wordBreak            {[a-zA-Z0-9_/]+}    0
  111. newModeVar HTML elecLBrace        0    1
  112. newModeVar HTML elecRBrace        0    1
  113. newModeVar HTML electricSemi    0    1
  114. newModeVar HTML wordWrap        1    1
  115. newModeVar HTML prefixString    $htmlCommentPreString    0
  116. newModeVar HTML suffixString    $htmlCommentSufString    0
  117. newModeVar HTML    optionIsMeta    1    1
  118. # Should tags be lower case?
  119. newModeVar HTML htmlUseLowerCase    0    1
  120. # Default number of discursive list entries
  121. newModeVar HTML    htmlDLEntries        3    0
  122. # Should TITLE generate HEAD and BODY?
  123. newModeVar HTML htmlUseHeadAndBody    0    1
  124. # Should •'s be inserted?
  125. newModeVar HTML    htmlUseTabMarks        1    1
  126. # Use opt-cmd or ctl-cmd?  Hack for int'l users.
  127. newModeVar HTML htmlUseCtlCmd        0    1
  128. # Prefer compact or open discursive lists?
  129. newModeVar HTML htmlCompactDiscLists    0    1
  130.  
  131. #
  132. # If user changes these, we need to rebind a lot of keys
  133. #
  134. trace vdelete  htmlUseCtlCmd w htmlTraceUCC
  135. trace variable htmlUseCtlCmd w htmlTraceUCC
  136. proc htmlTraceUCC {nm1 nm2 op} {
  137.     htmlBindKeys
  138.     return $nm1
  139. }
  140.  
  141. trace vdelete  htmlCompactDiscLists w htmlTraceCDL
  142. trace variable htmlCompactDiscLists w htmlTraceCDL
  143. proc htmlTraceCDL {nm1 nm2 op} {
  144.     htmlBindKeys
  145.     return $nm1
  146. }
  147.  
  148.  
  149. #
  150. # color support
  151. #
  152. set HTMLKeyWords {}
  153. regModeKeywords -b $htmlCommentPreString $htmlCommentSufString -m {<} -c red -k blue HTML $HTMLKeyWords
  154. #unset HTMLKeyWords
  155.  
  156. ######################################################################
  157. # Internal Globals
  158. ######################################################################
  159. set htmlLastLink    ""
  160. set htmlCurSel    ""
  161. set htmlIsSel    0
  162.  
  163. proc HTMLMarkFile {} {
  164.     set end [maxPos]
  165.     set pos 0
  166.     set l {}
  167.     set exp {^(<[Aa][^>]*>)?<([Hh][1-6]>[^<]*)</[Hh][1-6]>}
  168.  
  169.     while {![catch {search -f 1 -r 1 -m 0 -i 0 $exp $pos} res]} {
  170.         set start [lindex $res 0]
  171.         set end [lindex $res 1]
  172.         set text [lindex [split [getText $start $end] "<>"] 2]
  173.         set indlevel [getText [expr $start + 2] [expr $start + 3]]
  174.  
  175.         if {$indlevel > 0 && $indlevel < 7} {
  176.             set lab [string range "       " 2 $indlevel]
  177.             append lab $indlevel " " $text
  178.             setNamedMark $lab $start $start $end
  179.         }
  180.  
  181.         set pos $end
  182.     }
  183. }
  184.  
  185. # That's it for hooking into Alpha's mode mechanisms, the rest is just
  186. # straight html stuff.
  187.  
  188. ######################################################################
  189. # General Support Routines
  190. ######################################################################
  191.  
  192. # Snatch the current selection into htmlCurSel, set flag whether there is one
  193. proc htmlGetSel {} {
  194.     global htmlCurSel
  195.     global htmlIsSel
  196.     set htmlCurSel [getSelect]
  197.     set htmlIsSel [string length $htmlCurSel]
  198.     set htmlCurSel [string trim $htmlCurSel]
  199. }
  200.  
  201. # xxx - not done yet
  202. # This thing is supposed to look where the cursor is and remove the 
  203. # outermost tag marks, so automatically converted stuff can be 
  204. # beautified more easily.  I'm not sure how it should behave.  I'm not 
  205. # sure what to do if the selection spans a tag delimiter, for example.
  206. proc htmlUnTag {} {
  207.     global htmlCurSel
  208.     global htmlIsSel
  209.     htmlGetSel
  210.     createTmark htmlUnTagMark [getPos]
  211.     search -f 0 -r 1 "<\[\^<>\]\*</\.\*>"
  212. }
  213.  
  214. ######################################################################
  215. # Tags
  216. ######################################################################
  217.  
  218. # Build a tag boundary.  Decide if upper or lower case.
  219. proc htmlDoTag {text} {
  220.     global htmlUseLowerCase
  221.     insertText "<"
  222.     insertText [expr {${htmlUseLowerCase}?[string tolower $text]:[string toupper $text]}]
  223.     insertText ">"
  224. }
  225.  
  226. # This is used for all simple tags
  227. proc htmlBuildTag {ftype} {
  228.     global htmlUseTabMarks
  229.     global htmlCurSel
  230.     global htmlIsSel
  231.     htmlGetSel
  232.     if {$htmlIsSel} { deleteSelection }
  233.     htmlDoTag $ftype 
  234.     insertText $htmlCurSel
  235.     set currpos [getPos]
  236.     htmlDoTag /$ftype
  237. #    set c [lookAt [getPos]]
  238. #    if {$c != "\ "} {insertText " "} else {forwardChar}
  239.     if {!$htmlIsSel}    {
  240.         if {$htmlUseTabMarks} {insertText "•"}
  241.         goto $currpos
  242.     }
  243. }
  244.  
  245. # This is used for tags that should be on their own lines
  246. proc htmlBuildCRTag {ftype} {
  247.     global htmlUseTabMarks
  248.     global htmlCurSel
  249.     global htmlIsSel
  250.     htmlGetSel
  251.     if {$htmlIsSel} { deleteSelection }
  252.     htmlOpenCR
  253.     htmlDoTag $ftype 
  254.     insertText $htmlCurSel
  255.     set currpos [getPos]
  256.     htmlDoTag /$ftype
  257.     set start [getPos]
  258.     set end [nextLineStart $start]
  259.      set text [getText $start $end]
  260.     carriageReturn
  261.     if {!$htmlIsSel}    {
  262.         if {$htmlUseTabMarks} {insertText "•"}
  263.         goto $currpos
  264.     }
  265. }
  266.  
  267. # This is used for tags that should be surrounded by empty lines
  268. proc htmlBuildCR2Tag {ftype} {
  269.     global htmlUseTabMarks
  270.     global htmlCurSel
  271.     global htmlIsSel
  272.     htmlGetSel
  273.     if {$htmlIsSel} { deleteSelection }
  274. # note the tags are placed at the left margin, ignoring current indent
  275.     htmlOpenCR ; insertText "\n"
  276.     htmlDoTag $ftype 
  277.     carriageReturn
  278.     insertText $htmlCurSel
  279.     set currpos [getPos]
  280.     insertText "\n"
  281.     htmlDoTag /$ftype 
  282.     htmlCloseCR ; carriageReturn
  283.     if {!$htmlIsSel}    {
  284.         if {$htmlUseTabMarks} {insertText "•"}
  285.         goto $currpos
  286.     }
  287. }
  288.  
  289. #
  290. # Here are all the things that use them
  291. #
  292.  
  293. proc htmlTagAddress {} {
  294.     htmlBuildCRTag "ADDRESS"
  295.     message "Address"
  296. }
  297. proc htmlTagBlockquote {} {
  298.     htmlBuildCR2Tag "BLOCKQUOTE"
  299.     message "Blockquote"
  300. }
  301. proc htmlTagBold {} {
  302.     htmlBuildTag "B"
  303.     message "Bold"
  304. }
  305. proc htmlTagCite {} {
  306.     htmlBuildTag "CITE"
  307.     message "Cite"
  308. }
  309. proc htmlTagCode {} {
  310.     htmlBuildTag "CODE"
  311.     message "Code"
  312. }
  313. proc htmlTagDfn {} {
  314.     htmlBuildTag "DFN"
  315.     message "Definition"
  316. }
  317. proc htmlTagEmphasized {} {
  318.     htmlBuildTag "EM"
  319.     message "Emphasized"
  320. }
  321. proc htmlTagFixed {} {
  322.     htmlBuildTag "TT"
  323.     message "Fixed Width"
  324. }
  325. proc htmlTagForm {} {
  326.     htmlBuildCR2Tag "FORM"
  327.     message "Form"
  328. }
  329. proc htmlTagHR {} {
  330.     htmlDoTag "HR"
  331.     message "Horizontal Rule"
  332. }
  333. proc htmlTagItalic {} {
  334.     htmlBuildTag "I"
  335.     message "Italic"
  336. }
  337. proc htmlTagKeyboard {} {
  338.     htmlBuildTag "KBD"
  339.     message "Keyboard"
  340. }
  341. proc htmlTagUnderline {} {
  342.     htmlBuildTag "U"
  343.     message "Underline"
  344. }
  345. proc htmlTagSample {} {
  346.     htmlBuildCRTag "SAMP"
  347.     message "Sample"
  348. }
  349. proc htmlTagStrong {} {
  350.     htmlBuildTag "STRONG"
  351.     message "Strong emphasis"
  352. }
  353. proc htmlTagVarname {} {
  354.     htmlBuildTag "VAR"
  355.     message "Variable name"
  356. }
  357. proc htmlTagPreformatted {} {
  358.     htmlBuildCR2Tag "PRE"
  359.     message "Pre-formatted"
  360. }
  361. proc htmlTagListing {} {
  362.     htmlBuildCR2Tag "LISTING"
  363.     beep
  364.     message "Use 'Preformatted' instead"
  365. }
  366. proc htmlTagXMP {} {
  367.     htmlBuildCR2Tag "XMP"
  368.     beep
  369.     message "Use 'Preformatted' instead"
  370. }
  371.     
  372. proc htmlTagTitle {} {
  373.     global htmlUseTabMarks
  374.     global htmlUseHeadAndBody
  375.     global htmlCurSel
  376.     global htmlIsSel
  377.     if {$htmlUseHeadAndBody} {
  378.         htmlGetSel
  379.         set htmlTTIsSel $htmlIsSel
  380.         if {$htmlTTIsSel} { 
  381.             set htmlTTCurSel $htmlCurSel
  382.             deleteSelection 
  383.         }
  384.         htmlDoTag "HTML"
  385.         htmlBuildCRTag "HEAD"
  386.         htmlBuildCRTag "TITLE"
  387.         if {$htmlTTIsSel} {
  388.             insertText $htmlTTCurSel
  389.         } else {
  390.             createTMark htmlTTMark [getPos]
  391.         }
  392.         htmlTabNext; htmlTabNext
  393.         htmlBuildCR2Tag "BODY"
  394.         if {!$htmlTTIsSel} {
  395.             if {$htmlUseTabMarks} {insertText "•"}
  396.         } else {
  397.             createTMark htmlTTMark [getPos]
  398.         }
  399.         htmlTabNext
  400.         htmlDoTag "/HTML"
  401.         gotoTMark htmlTTMark
  402.         removeTMark htmlTTMark
  403.     } else {
  404.         htmlBuildCRTag "TITLE"
  405.     }
  406.     message "Document title"
  407. }
  408.  
  409. proc htmlTagHeader1 {} {
  410.     htmlBuildCRTag "H1"
  411. }
  412. proc htmlTagHeader2 {} {
  413.     htmlBuildCRTag "H2"
  414. }
  415. proc htmlTagHeader3 {} {
  416.     htmlBuildCRTag "H3"
  417. }
  418. proc htmlTagHeader4 {} {
  419.     htmlBuildCRTag "H4"
  420. }
  421. proc htmlTagHeader5 {} {
  422.     htmlBuildCRTag "H5"
  423. }
  424. proc htmlTagHeader6 {} {
  425.     htmlBuildCRTag "H6"
  426. }
  427.  
  428.  
  429. #
  430. # Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
  431. # insertion point there.  If anything is selected, makes it the first item.
  432. #
  433. proc htmlBuildList {ltype} {
  434.     global htmlUseTabMarks
  435.     global htmlCurSel
  436.     global htmlIsSel
  437.     htmlGetSel
  438.     if {$htmlIsSel} { deleteSelection }
  439.     htmlOpenCR
  440.     htmlDoTag $ltype
  441.     carriageReturn
  442.     htmlDoTag "LI"
  443.     insertText " "
  444.     if {$htmlIsSel} {        # bullet 1 already full
  445.         insertText $htmlCurSel 
  446.         carriageReturn
  447.         htmlDoTag "LI"
  448.         insertText " "
  449.     }
  450.     set currpos [getPos]
  451.     carriageReturn
  452.     htmlDoTag /$ltype
  453.     carriageReturn
  454.     if {!$htmlIsSel && $htmlUseTabMarks} {insertText "•"}
  455.     htmlCloseCR
  456.     if {!$htmlIsSel} {goto $currpos}
  457.  
  458. }
  459.  
  460. # Add list entry.  If there is a selection, make it the entry.
  461. proc htmlTagListEntry {} {
  462.     global htmlCurSel
  463.     global htmlIsSel
  464.     htmlGetSel
  465.     htmlOpenCR
  466.     htmlDoTag "LI"
  467.     insertText " " $htmlCurSel
  468.     message "New entry"
  469. }
  470.  
  471. #
  472. #  Here are all the things that use buildList:
  473. #
  474.  
  475. proc htmlTagBulleted {} {
  476.     htmlBuildList "UL"
  477.     message "Bulleted list"
  478. }
  479. proc htmlTagNumbered {} {
  480.     htmlBuildList "OL"
  481.     message "Numbered list"
  482. }
  483. proc htmlTagMenu {} {
  484.     htmlBuildList "MENU"
  485.     message "Menu"
  486. }
  487. proc htmlTagDirectory {} {
  488.     htmlBuildList "DIR"
  489.     message "Directory"
  490. }
  491.  
  492.  
  493. #
  494. # Discursive Lists (terms and description tags)
  495. #
  496. # The selection becomes the *description* (*not* the term)
  497. #
  498.  
  499. # Build a "compact" glossary
  500. proc htmlDiscCompact {} {
  501.     global htmlUseTabMarks
  502.     global htmlCurSel
  503.     global htmlIsSel
  504.     global htmlDLEntries
  505.     if {![catch {prompt "Compact Discursive List: how many entries?" $htmlDLEntries} \
  506.             numberEntries] && $numberEntries > 0} {
  507.         htmlGetSel
  508.         if {$htmlIsSel} { deleteSelection }
  509.         htmlOpenCR
  510.         htmlDoTag "DL COMPACT"
  511.         carriageReturn
  512.         htmlDoTag "DT"
  513.         insertText " "
  514.         set currpos [getPos]
  515.         insertText "\t"
  516.         htmlDoTag "DD"
  517.         insertText " "
  518.         if {$htmlIsSel} {
  519.             insertText $htmlCurSel
  520.         } else {
  521.             if {$htmlUseTabMarks} {insertText " •"}
  522.         }        
  523.         for {set i 1} {$i < $numberEntries} {incr i} {
  524.             carriageReturn
  525.             htmlDoTag "DT"
  526.             if {$htmlUseTabMarks} {insertText " •"}
  527.             insertText "\t"
  528.             htmlDoTag "DD"
  529.             if {$htmlUseTabMarks} {insertText " •"}
  530.         }
  531.         carriageReturn
  532.         htmlDoTag "/DL"    
  533.         carriageReturn
  534.         if {$htmlUseTabMarks} {insertText "•"}
  535.         htmlCloseCR
  536.         goto $currpos
  537.     }
  538. }
  539.  
  540. # Build a discursive list with more space
  541. proc htmlDiscLong {} {
  542.     global htmlUseTabMarks
  543.     global htmlCurSel
  544.     global htmlIsSel
  545.     global htmlDLEntries
  546.     if {![catch {prompt "Discursive List: how many entries?" $htmlDLEntries} \
  547.             numberEntries] && $numberEntries > 0} {
  548.         htmlGetSel
  549.         if {$htmlIsSel} { deleteSelection }
  550.         htmlOpenCR
  551.         htmlDoTag "DL"
  552.         carriageReturn
  553.         htmlDoTag "DT"
  554.         insertText " "
  555.         set currpos [getPos]
  556.         carriageReturn
  557.         insertText "\t"
  558.         htmlDoTag "DD"
  559.         insertText " "
  560.         if {$htmlIsSel} {
  561.             insertText $htmlCurSel
  562.         } else {
  563.             if {$htmlUseTabMarks} {insertText " •"}
  564.         }        
  565.         for {set i 1} {$i < $numberEntries} {incr i} {
  566.             carriageReturn ; carriageReturn
  567.             backwardChar
  568.             deleteChar
  569.             htmlDoTag "DT"
  570.             if {$htmlUseTabMarks} {insertText " •"}
  571.             carriageReturn
  572.             insertText "\t"
  573.             htmlDoTag "DD"
  574.             if {$htmlUseTabMarks} {insertText " •"}
  575.         }
  576.         carriageReturn
  577.         backwardChar
  578.         deleteChar
  579.         htmlDoTag "/DL"
  580.         carriageReturn
  581.         if {$htmlUseTabMarks} {insertText "•"}
  582.         htmlCloseCR
  583.         goto $currpos
  584.     }
  585. }
  586.  
  587. # Add an individual entry to a discursive list
  588. proc htmlTagDiscEntry {} {
  589.     global htmlUseTabMarks
  590.     global htmlCurSel
  591.     global htmlIsSel
  592.     htmlGetSel
  593.     if {$htmlIsSel} { deleteSelection }
  594.     htmlOpenCR
  595.     htmlDoTag "DT"
  596.     insertText " "
  597.     set currpos [getPos]
  598.     insertText "\t"
  599.     htmlDoTag "DD"
  600.     insertText " "
  601.     if {$htmlIsSel} {
  602.         insertText $htmlCurSel
  603.     } else {
  604.         if {$htmlUseTabMarks} {insertText "•"}
  605.     }
  606.     htmlCloseCR
  607.     goto $currpos
  608. }
  609.  
  610.  
  611. #
  612. # hrefs
  613. #
  614.  
  615. # An href points to an anchor
  616. # If text is selected it is made clickable.
  617. proc htmlTagHref {} {
  618.     global htmlUseTabMarks
  619.     global htmlCurSel
  620.     global htmlIsSel
  621.     global htmlLastLink
  622.     global htmlUseLowerCase
  623.     htmlGetSel
  624.  
  625.     set defref $htmlLastLink
  626.     if {![catch {prompt "HREF to?" $defref} defref]} {
  627.         if {$htmlIsSel} deleteSelection
  628.         if {$htmlUseLowerCase} {
  629.             insertText "<a href=\""
  630.         } else {
  631.             insertText "<A HREF=\""
  632.         }
  633.         insertText $defref "\">" $htmlCurSel
  634.         set currpos [getPos]
  635.         htmlDoTag "/A"
  636.         if {!$htmlIsSel} {
  637.             if {$htmlUseTabMarks} {insertText "•"}
  638.             goto $currpos
  639.         }
  640.         set htmlLastLink $defref
  641.     }
  642. }
  643.  
  644. # An anchor is something which is pointed to by an href.
  645. # If text is selected it is the object of the href.
  646. proc htmlTagAnchor {} {
  647.     global htmlUseTabMarks
  648.     global htmlCurSel
  649.     global htmlIsSel
  650.     global htmlLastLink
  651.     global htmlUseLowerCase
  652.     htmlGetSel
  653.     if {![catch {prompt "Anchor name?" $htmlLastLink} defref]} {
  654.         if {$htmlIsSel} deleteSelection
  655.         if {$htmlUseLowerCase} {
  656.             insertText "<a name=\""
  657.         } else {
  658.             insertText "<A NAME=\""
  659.         }
  660.         insertText $defref "\">" $htmlCurSel        
  661.         set currpos [getPos]
  662.         htmlDoTag "/A"
  663.         if {!$htmlIsSel} {
  664.             if {$htmlUseTabMarks} {insertText "•"}
  665.             goto $currpos
  666.         }
  667.         set htmlLastLink $defref
  668.     }            
  669. }
  670.  
  671. # Inline image href
  672. # If text is selected it is made clickable.
  673. proc htmlTagImg {} {
  674.     global HOME
  675.     global htmlCurSel
  676.     global htmlIsSel
  677.     global htmlUseLowerCase
  678.     htmlGetSel
  679.     if {$htmlIsSel} {
  680.         set defref $htmlCurSel 
  681.     } else {
  682.         set defref ""
  683.     }
  684.     if {![catch {prompt "Image URL?" $defref} defref]} {
  685.         if {$htmlIsSel} deleteSelection
  686.         htmlOpenCR
  687.         if {$htmlUseLowerCase} {
  688.             insertText "<a img src=\""
  689.         } else {
  690.             insertText "<IMG SRC=\""
  691.         }
  692.         insertText $defref "\">"
  693.         htmlCloseCR
  694.         message "Inline image"
  695.     }
  696. }
  697.  
  698.  
  699. ######################################################################
  700.  
  701.  
  702. #
  703. # The following are straight from latex.tcl (thanks!)
  704. #
  705.  
  706. # A boolean function which takes any string and tests to see if
  707. # that string contains all whitespace characters.  Carriage returns 
  708. # are considered whitespace, as are spaces and tabs.
  709. proc htmlIsWhite {anyString} {
  710.     set len [string length $anyString]
  711.     for {set i 0} {$i < $len} {incr i} {
  712.         set c [string index $anyString $i]
  713.         if {($c != "\ ") && ($c != "\t") && ($c != "\r")} then {return 0}
  714.     }
  715.     return 1
  716. }
  717.  
  718. # Insert a carriage return at the insertion point if any
  719. # character preceding the insertion point (on the same line)
  720. # is a non-whitespace character.
  721. proc htmlOpenCR {} {
  722.     set end [getPos]
  723.     set start [lineStart $end]
  724.     set text [getText $start $end]
  725.     if {![htmlIsWhite $text]} carriageReturn
  726. }
  727.  
  728. # Insert a carriage return at the insertion point if any
  729. # character following the insertion point (on the same line)
  730. # is a non-whitespace character.
  731. proc htmlCloseCR {} {
  732.     set start [getPos]
  733.     set end [nextLineStart $start]
  734.     set text [getText $start $end]
  735.     if {![htmlIsWhite $text]} carriageReturn
  736. }
  737.  
  738. # Set up tab stop mechanism.
  739. proc htmlTabGoto {directionIndicator} {
  740.     set searchResult [search -n -f $directionIndicator -m 0 -i 1 -r 0 {•} [getPos]]
  741.     if {[llength $searchResult] == 0} then {
  742.         message "Tab stop not found"
  743.         return 0
  744.     } else {
  745.         goto [lindex $searchResult 0]
  746.         return 1
  747.     }
  748. }
  749. proc htmlTabNext {} {
  750.     if {[htmlTabGoto 1]} {deleteChar}
  751. }
  752. proc htmlTabPrev {} {
  753.     if {[htmlTabGoto 0]} {deleteChar}
  754. }
  755.  
  756. proc htmlTabDeleteAll {} {
  757.     createTMark htmlDelTabMark [getPos]
  758.     goto 0
  759.     set searchpos 0
  760.     while {1} {
  761.         if {$searchpos == [maxPos]} break
  762.         set searchResult [search -f 1 -r 0 -m 0 -n {•} $searchpos]
  763.         if {[llength $searchResult] == 0} break
  764.         deleteText [lindex $searchResult 0] [lindex $searchResult 1]
  765.         set searchpos [getPos]
  766.     }
  767.     message "Tab stops deleted"
  768.     gotoTMark htmlDelTabMark
  769.     removeTMark htmlDelTabMark
  770. }
  771.  
  772. #########################
  773. #
  774. # Procs for HTML special characters
  775. #
  776. #########################
  777.  
  778. # These three are bound to the single keys
  779. proc htmlLt {} {
  780.     global htmlIsSel
  781.     htmlGetSel
  782.     if {$htmlIsSel} { deleteSelection }
  783.     insertText "<\;"
  784. }
  785. proc htmlGt {} {
  786.     global htmlIsSel
  787.     htmlGetSel
  788.     if {$htmlIsSel} { deleteSelection }
  789.     insertText ">\;"
  790. }
  791. proc htmlAmp {} {
  792.     global htmlIsSel
  793.     htmlGetSel
  794.     if {$htmlIsSel} { deleteSelection }
  795.     insertText "&\;"
  796. }
  797.  
  798. # The next three allow you to input the real characters
  799. proc htmlLT {} {
  800.     global htmlIsSel
  801.     htmlGetSel
  802.     if {$htmlIsSel} { deleteSelection }
  803.     insertText "<"
  804. }
  805. proc htmlGT {} {
  806.     global htmlIsSel
  807.     htmlGetSel
  808.     if {$htmlIsSel} { deleteSelection }
  809.     insertText ">"
  810. }
  811. proc htmlAMP {} {
  812.     global htmlIsSel
  813.     htmlGetSel
  814.     if {$htmlIsSel} { deleteSelection }
  815.     insertText "&"
  816. }
  817.  
  818.                        
  819.  
  820. ########################################################################
  821. #
  822. # Menus
  823. #
  824. ########################################################################
  825. # Break
  826. proc htmlBreak {} {
  827.     htmlDoTag "BR"
  828.     carriageReturn
  829. }
  830.  
  831. # CRs before <p>
  832. proc htmlParagraph {} {
  833.     global htmlIsSel
  834.     htmlGetSel
  835.     if {$htmlIsSel} { deleteSelection }
  836.     carriageReturn
  837.     carriageReturn
  838.     htmlDoTag "P"
  839. }
  840.  
  841. # no CRs before <p>
  842. proc htmlParaMark {} {
  843.     global htmlIsSel
  844.     htmlGetSel
  845.     if {$htmlIsSel} { deleteSelection }
  846.     htmlDoTag "P"
  847. }
  848.  
  849. proc htmlComment {} {
  850.     global htmlUseTabMarks
  851.     global htmlCurSel
  852.     global htmlIsSel
  853.     global htmlCommentPreString htmlCommentSufString
  854.  
  855.     htmlGetSel
  856.     if {$htmlIsSel} { deleteSelection }
  857.     htmlOpenCR
  858.     insertText $htmlCommentPreString $htmlCurSel 
  859.     set currpos [getPos]
  860.     insertText $htmlCommentSufString
  861.     htmlCloseCR
  862.     if {!$htmlIsSel}    {
  863.         if {$htmlUseTabMarks} {insertText "•"}
  864.         goto $currpos
  865.     }
  866. }
  867.  
  868. proc htmlMenuItem {menu item} {
  869.     global htmlIsSel
  870.  
  871.     case $menu in {
  872.         {"Html" •942} {
  873.             case $item in {
  874.                 "newParagraph"    {htmlParagraph}
  875.                 "paragraphMark"    {htmlParaMark}
  876.                 "break"            {htmlBreak}
  877.                 "comment"    {htmlComment}
  878.                 "removeTabMarks"    {htmlTabDeleteAll}
  879.             }
  880.         }    
  881.         "Headers" {
  882.             case $item in {
  883.                 "header1"    {htmlTagHeader1}
  884.                 "header2"    {htmlTagHeader2}
  885.                 "header3"    {htmlTagHeader3}
  886.                 "header4"    {htmlTagHeader4}
  887.                 "header5"    {htmlTagHeader5}
  888.                 "header6"    {htmlTagHeader6}
  889.             }
  890.         }
  891.         "Styles"    {
  892.             case $item in {
  893.                 "emphasis"        {htmlTagEmphasized}
  894.                 "strong"        {htmlTagStrong}
  895.                 "bold"            {htmlTagBold}
  896.                 "italic"        {htmlTagItalic}
  897.                 "fixedWidth"    {htmlTagFixed}
  898.                 "keyboard"        {htmlTagKeyboard}
  899.                 "underline"        {htmlTagUnderline}
  900.             }
  901.         }
  902.         "Lists"    {
  903.             case $item in {
  904.                 "addEntry"    {htmlTagListEntry}
  905.                 "bulleted"    {htmlTagBulleted}
  906.                 "numbered"    {htmlTagNumbered}
  907.                 "menu"        {htmlTagMenu}
  908.                 "directory"    {htmlTagDirectory}
  909.             }
  910.         }
  911.         {"Other Tags" "otherTags"}    {
  912.             case $item in {
  913.                 "preformatted"    {htmlTagPreformatted}
  914.                 "title"            {htmlTagTitle}
  915.                 "address"        {htmlTagAddress}
  916.                 "blockquote"    {htmlTagBlockquote}
  917.                 "cite"            {htmlTagCite}
  918.                 "code"            {htmlTagCode}
  919.                 "definition"    {htmlTagDfn}
  920.                 "form"            {htmlTagForm}
  921.                 "horizRule"        {htmlTagHR}
  922.                 "listing"        {htmlTagListing}
  923.                 "sample"        {htmlTagSample}
  924.                 "variable"        {htmlTagVarname}
  925.                 "xMP"            {htmlTagXMP}
  926.             }
  927.         }
  928.         {"discursiveLists" "Discursive Lists"}    {
  929.             case $item in {
  930.                 "addEntry"    {htmlTagDiscEntry}
  931.                 "compactList"    {htmlDiscCompact}
  932.                 "moreSpace" {htmlDiscLong}
  933.             }
  934.         }
  935.         "Hyperlinks"    {
  936.             case $item in {
  937.                 "addHref"    {htmlTagHref}
  938.                 "addAnchor"    {htmlTagAnchor}
  939.                 "addIMG"    {htmlTagImg}
  940.             }
  941.         }
  942.         # Characters: only work by putting a leading space on menu items
  943.         "Characters"    {
  944.             case $item in {
  945.                 "lessthan"    {htmlLt}
  946.                 "greaterthan"    {htmlGt}
  947.                 "ampersand"    {htmlAmp}
  948.                 default        {
  949.                     htmlGetSel
  950.                     if {$htmlIsSel} { deleteSelection }
  951.                     set item [string trim $item]
  952.                     insertText &${item}\;
  953.                 }
  954.             }
  955.         }
  956.     } 
  957.  
  958. }
  959.  
  960. menu -n $htmlMenu -p htmlMenuItem  {
  961.  
  962.     "spellcheckWindow"
  963.     "(-"
  964.     "newParagraph"
  965.     "paragraphMark"
  966.     "break"
  967.     "comment"
  968.     "removeTabMarks"
  969.     "(-"
  970.     
  971.     {menu -n Headers -p htmlMenuItem {
  972.         "header1"
  973.         "header2"
  974.         "header3"
  975.         "header4"
  976.         "header5"
  977.         "header6" 
  978.     }}
  979.  
  980.     {menu -n Styles -p htmlMenuItem {
  981.         "emphasis"
  982.         "strong"
  983.         "bold"
  984.         "italic"
  985.         "fixedWidth"
  986.         "Keyboard"
  987.         "Underline"
  988.     }}    
  989.  
  990.     {menu -n "Lists" -p htmlMenuItem {
  991.         "addEntry"
  992.         "(-"
  993.         "bulleted"
  994.         "numbered"
  995.         "menu"
  996.         "directory" 
  997.     }}
  998.  
  999.     {menu -n "Discursive Lists" -p htmlMenuItem {
  1000.         "Add Entry"
  1001.         "(-"
  1002.         "compactList"
  1003.         "moreSpace" 
  1004.     }}
  1005.  
  1006.     {menu -n "Other Tags" -p htmlMenuItem {
  1007.         "preformatted"
  1008.         "title"
  1009.         "address"
  1010.         "blockquote"
  1011.         "cite"
  1012.         "code"
  1013.         "definition"
  1014.         "form"
  1015.         "horizRule"
  1016.         "listing"
  1017.         "sample"
  1018.         "variable"
  1019.         "xMP" 
  1020.     }}
  1021.  
  1022.     {menu -n Hyperlinks -p htmlMenuItem {
  1023.         "addHref"
  1024.         "addAnchor"
  1025.         "addIMG" 
  1026.     }}
  1027.  
  1028.     "(-"
  1029.  
  1030.     {menu -n Characters -p htmlMenuItem {
  1031.         "lessthan"
  1032.         "greaterthan"
  1033.         "ampersand"
  1034.         "(-"
  1035.         " Aacute"
  1036.         " Acirc"
  1037.         " Acircumflex"
  1038.         " Adieresis"
  1039.         " AE"
  1040.         " AElig"
  1041.         " Agrave"
  1042.         " Aring"
  1043.         " Atilde"
  1044.         " Auml"
  1045.         " Ccedil"
  1046.         " Ccedilla"
  1047.         " Delta"
  1048.         " Eacute"
  1049.         " Ecirc"
  1050.         " Ecircumflex"
  1051.         " Edieresis"
  1052.         " Egrave"
  1053.         " Eth"
  1054.         " Euml"
  1055.         " Iacute"
  1056.         " Icirc"
  1057.         " Icircumflex"
  1058.         " Idieresis"
  1059.         " Igrave"
  1060.         " Iuml"
  1061.         " Ntilde"
  1062.         " OE"
  1063.         " Oacute"
  1064.         " Ocirc"
  1065.         " Ocircumflex"
  1066.         " Odieresis"
  1067.         " Ograve"
  1068.         " Omega"
  1069.         " Oslash"
  1070.         " Otilde"
  1071.         " Ouml"
  1072.         " Pi"
  1073.         " Sigma"
  1074.         " Thorn"
  1075.         " Uacute"
  1076.         " Ucirc"
  1077.         " Ucircumflex"
  1078.         " Udieresis"
  1079.         " Ugrave"
  1080.         " Uuml"
  1081.         " Yacute"
  1082.         " Ydieresis"
  1083.         " Ygrave"
  1084.         " aacute"
  1085.         " acirc"
  1086.         " acircumflex"
  1087.         " adieresis"
  1088.         " ae"
  1089.         " aelig"
  1090.         " agrave"
  1091.         " apple"
  1092.         " approxequal"
  1093.         " aring"
  1094.         " atilde"
  1095.         " auml"
  1096.         " breve"
  1097.         " bullet"
  1098.         " caron"
  1099.         " ccedil"
  1100.         " ccedilla"
  1101.         " cedilla"
  1102.         " cent"
  1103.         " circumflex"
  1104.         " copyright"
  1105.         " currency"
  1106.         " dagger"
  1107.         " daggerdbl"
  1108.         " degree"
  1109.         " dieresis"
  1110.         " divide"
  1111.         " dotaccent"
  1112.         " dotlessi"
  1113.         " eacute"
  1114.         " eacute"
  1115.         " ecirc"
  1116.         " ecircumflex"
  1117.         " edieresis"
  1118.         " egrave"
  1119.         " ellipsis"
  1120.         " emdash"
  1121.         " emsp"
  1122.         " endash"
  1123.         " ensp"
  1124.         " eth"
  1125.         " euml"
  1126.         " exclamdown"
  1127.         " fi"
  1128.         " fl"
  1129.         " florin"
  1130.         " fraction"
  1131.         " germandbls"
  1132.         " greaterequal"
  1133.         " guillemotleft"
  1134.         " guillemotright"
  1135.         " guilsinglleft"
  1136.         " guilsinglright"
  1137.         " hellip"
  1138.         " hungarumlaut"
  1139.         " iacute"
  1140.         " icirc"
  1141.         " icircumflex"
  1142.         " idieresis"
  1143.         " igrave"
  1144.         " infinity"
  1145.         " integral"
  1146.         " iuml"
  1147.         " lessequal"
  1148.         " logicalnot"
  1149.         " lozenge"
  1150.         " macron"
  1151.         " mdash"
  1152.         " mu"
  1153.         " nbsp"
  1154.         " ndash"
  1155.         " nobrkspace"
  1156.         " notequal"
  1157.         " ntilde"
  1158.         " oacute"
  1159.         " ocirc"
  1160.         " ocircumflex"
  1161.         " odieresis"
  1162.         " oe"
  1163.         " ogonek"
  1164.         " ograve"
  1165.         " ordfeminine"
  1166.         " ordmasculine"
  1167.         " oslash"
  1168.         " otilde"
  1169.         " ouml"
  1170.         " paragraph"
  1171.         " partialdiff"
  1172.         " periodcentered"
  1173.         " perthousand"
  1174.         " pi"
  1175.         " plusminus"
  1176.         " questiondown"
  1177.         " quot"
  1178.         " quotedblbase"
  1179.         " quotedblleft"
  1180.         " quotedblright"
  1181.         " quoteleft"
  1182.         " quoteright"
  1183.         " quotesinglbase"
  1184.         " radical"
  1185.         " registered"
  1186.         " ring"
  1187.         " section"
  1188.         " shy"
  1189.         " sterling"
  1190.         " szlig"
  1191.         " thorn"
  1192.         " tilde"
  1193.         " trademark"
  1194.         " uacute"
  1195.         " ucirc"
  1196.         " ucircumflex"
  1197.         " udieresis"
  1198.         " ugrave"
  1199.         " uuml"
  1200.         " vellip"
  1201.         " yacute"
  1202.         " ydieresis"
  1203.         " yen"
  1204.         " yuml"
  1205.     }}
  1206.     
  1207. }
  1208.     
  1209. #############################################################################
  1210. #
  1211. # Key Bindings.
  1212. #
  1213. # abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
  1214. #
  1215. #############################################################################
  1216.  
  1217. proc htmlBindKeys {} {
  1218.     global htmlCompactDiscLists htmlUseCtlCmd
  1219.     
  1220.     # this is in 5.92 and beyond.
  1221.     catch {deleteModeBindings "HTML"}
  1222.     
  1223.     if (![info exists htmlCompactDiscLists]) {
  1224.         set htmlCompactDiscLists 0
  1225.     }
  1226.     if (![info exists htmlUseCtlCmd]) {
  1227.         set htmlUseCtlCmd 0
  1228.     }
  1229.  
  1230.     if ($htmlCompactDiscLists) {
  1231.         set htmlDLPref htmlDiscCompact
  1232.         set htmlDLAlt  htmlDiscLong
  1233.     } else {
  1234.         set htmlDLPref htmlDiscLong
  1235.         set htmlDLAlt  htmlDiscCompact
  1236.     }    
  1237.     if ($htmlUseCtlCmd) {set htmlBStr "zc"}   else {set htmlBStr "oc"}
  1238.     if ($htmlUseCtlCmd) {set htmlSBStr "szc"} else {set htmlSBStr "soc"}
  1239.  
  1240.     bind 0x30        htmlTabNext        "HTML"
  1241.     bind 0x30    <s> htmlTabPrev    "HTML"
  1242.     
  1243.     # enter & opt-cmd-enter for new-paragraph
  1244.     bind Enter        htmlParagraph    "HTML"
  1245.     bind Enter    <$htmlBStr>    htmlParaMark    "HTML"
  1246.     # (for powerbook 100) xxx - this feels dangerous
  1247.     bind 0x34        htmlParagraph    "HTML"
  1248.     bind 0x34    <$htmlBStr>    htmlParaMark    "HTML"
  1249.     # for those with awkward Enter keys
  1250.     bind 'm'    <z>    htmlParagraph    "HTML"
  1251.     
  1252.     # Comment on semicolon
  1253.     bind 0x29    <$htmlBStr>    htmlComment    "HTML"
  1254.     
  1255.     bind '0'    <$htmlBStr>    htmlTagTitle    "HTML"
  1256.     bind '1'    <$htmlBStr>    htmlTagHeader1    "HTML"
  1257.     bind '1'    <$htmlSBStr>    htmlBreak        "HTML"
  1258.     bind '2'     <$htmlBStr>    htmlTagHeader2    "HTML"
  1259.     bind '3'     <$htmlBStr>    htmlTagHeader3    "HTML"
  1260.     bind '4'     <$htmlBStr>    htmlTagHeader4    "HTML"
  1261.     bind '5'     <$htmlBStr>    htmlTagHeader5    "HTML"
  1262.     bind '6'     <$htmlBStr>    htmlTagHeader6    "HTML"
  1263.     
  1264.     bind 'e'    <$htmlBStr>    htmlTagEmphasized    "HTML"
  1265.     bind 's'    <$htmlBStr>    htmlTagStrong    "HTML"
  1266.     bind 'b'    <$htmlBStr>    htmlTagBold        "HTML"
  1267.     bind 'i'    <$htmlBStr>    htmlTagItalic    "HTML"
  1268.     bind 'f'    <$htmlBStr>    htmlTagFixed    "HTML"
  1269.     bind 'k'    <$htmlBStr>    htmlTagKeyboard    "HTML"
  1270.     
  1271.     bind 'n'    <$htmlBStr>    htmlTagListEntry    "HTML"
  1272.     bind 'u'    <$htmlBStr>    htmlTagBulleted    "HTML"
  1273.     bind 'o'    <$htmlBStr>    htmlTagNumbered    "HTML"
  1274.     bind 'm'    <$htmlBStr>    htmlTagMenu        "HTML"
  1275.     bind 'd'    <$htmlBStr>    htmlTagDirectory    "HTML"
  1276.     
  1277.     bind 'p'    <$htmlBStr>    htmlTagPreformatted    "HTML"
  1278.     bind 't'    <$htmlBStr>    htmlTagTitle    "HTML"
  1279.     bind 'c'    <$htmlBStr>    htmlTagCode        "HTML"
  1280.     bind 'c'    <$htmlSBStr>    htmlTagCite        "HTML"
  1281.     bind 'q'    <$htmlBStr>    htmlTagBlockquote    "HTML"
  1282.     bind 's'    <$htmlSBStr>    htmlTagSample    "HTML"
  1283.     bind 'a'    <$htmlBStr>    htmlTagAddress    "HTML"
  1284.     bind 'v'    <$htmlBStr>    htmlTagVarname    "HTML"
  1285.     bind 'l'    <$htmlBStr>    htmlTagListing    "HTML"
  1286.     bind 'x'    <$htmlBStr>    htmlTagXMP        "HTML"
  1287.     
  1288.     # Discursive List stuff
  1289.     bind 'n'    <$htmlSBStr>    htmlTagDiscEntry    "HTML"
  1290.     bind 'g'    <$htmlBStr>    $htmlDLPref                "HTML"
  1291.     bind 'g'    <$htmlSBStr>    $htmlDLAlt            "HTML"
  1292.     
  1293.     # A "<" is something pointed at.  ">" points to it.
  1294.     bind '.'    <$htmlBStr>    htmlTagHref    "HTML"
  1295.     bind ','    <$htmlBStr>    htmlTagAnchor    "HTML"
  1296.     
  1297.     # An image, right near the usual href
  1298.     bind '/'    <$htmlBStr>    htmlTagImg    "HTML"
  1299.     
  1300.     # "<", ">" and "&" insert their "&" versions.  Shift inserts character.
  1301.     bind ','    <s>        htmlLt    "HTML"
  1302.     bind ','    <$htmlSBStr>    htmlLT    "HTML"
  1303.     bind '.'    <s>        htmlGt    "HTML"
  1304.     bind '.'    <$htmlSBStr>    htmlGT    "HTML"
  1305.     bind '7'    <s>        htmlAmp    "HTML"
  1306.     bind '7'    <$htmlSBStr>    htmlAMP    "HTML"
  1307.     
  1308.     # ISO character entities ...
  1309.     #    I can't put all of them on bindings, and different users want
  1310.     #    different ones.  So skip it.
  1311.     
  1312. }
  1313.  
  1314. # bind the keys based on defaults.  Shadowing will rebind later in 
  1315. # userStartup.tcl.
  1316. htmlBindKeys
  1317.  
  1318. proc htmlDummy {} {}
  1319.